home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MLT_TASK / PIBMDOS / GETSCREN.PAS < prev    next >
Pascal/Delphi Source File  |  1988-03-14  |  6KB  |  129 lines
  1. (*----------------------------------------------------------------------*)
  2. (*    Color_Screen_Active --- Determine if color or mono screen         *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. FUNCTION Color_Screen_Active : BOOLEAN;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Function:   Color_Screen_Active                                  *)
  10. (*                                                                      *)
  11. (*     Purpose:    Determines if color or mono screen active            *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Color_Active := Color_Screen_Active : BOOLEAN;                *)
  16. (*                                                                      *)
  17. (*           Color_Active --- set to TRUE if the color screen is        *)
  18. (*                            active, FALSE if the mono screen is       *)
  19. (*                            active.                                   *)
  20. (*                                                                      *)
  21. (*     Calls:   INTR                                                    *)
  22. (*                                                                      *)
  23. (*----------------------------------------------------------------------*)
  24.  
  25. VAR
  26.    Regs : Registers;
  27.  
  28. BEGIN  (* Color_Screen_Active *)
  29.  
  30.    Regs.Ax := 15 SHL 8;
  31.  
  32.    INTR( $10 , Regs );
  33.  
  34.    Color_Screen_Active := ( Regs.Al <> 7 );
  35.  
  36. END    (* Color_Screen_Active *);
  37.  
  38. (*----------------------------------------------------------------------*)
  39. (*     Current_Video_Mode --- Determine current video mode setting      *)
  40. (*----------------------------------------------------------------------*)
  41.  
  42. FUNCTION Current_Video_Mode: INTEGER;
  43.  
  44. (*----------------------------------------------------------------------*)
  45. (*                                                                      *)
  46. (*     Function:   Current_Video_Mode                                   *)
  47. (*                                                                      *)
  48. (*     Purpose:    Gets current video mode setting from system          *)
  49. (*                                                                      *)
  50. (*     Calling Sequence:                                                *)
  51. (*                                                                      *)
  52. (*        Current_Mode := Current_Video_Mode : INTEGER;                 *)
  53. (*                                                                      *)
  54. (*           Current_Mode --- set to integer representing current       *)
  55. (*                            video mode inherited from system.         *)
  56. (*                                                                      *)
  57. (*     Calls:   INTR                                                    *)
  58. (*                                                                      *)
  59. (*----------------------------------------------------------------------*)
  60.  
  61. VAR
  62.    Regs : Registers;
  63.  
  64. BEGIN  (* Current_Video_Mode *)
  65.  
  66.    Regs.Ax := 15 SHL 8;
  67.  
  68.    INTR( $10 , Regs );
  69.  
  70.    Current_Video_Mode := Regs.Al;
  71.  
  72. END    (* Current_Video_Mode *);
  73.  
  74. (*----------------------------------------------------------------------*)
  75. (*        Get_Screen_Address --- Get address of current screen          *)
  76. (*----------------------------------------------------------------------*)
  77.  
  78. PROCEDURE Get_Screen_Address( VAR Actual_Screen : Screen_Ptr );
  79.  
  80. (*----------------------------------------------------------------------*)
  81. (*                                                                      *)
  82. (*     Procedure:  Get_Screen_Address                                   *)
  83. (*                                                                      *)
  84. (*     Purpose:    Gets screen address for current type of display      *)
  85. (*                                                                      *)
  86. (*     Calling Sequence:                                                *)
  87. (*                                                                      *)
  88. (*        Get_Screen_Address( VAR Actual_Screen : Screen_Ptr );         *)
  89. (*                                                                      *)
  90. (*           Actual_Screen --- pointer whose value receives the         *)
  91. (*                             current screen address.                  *)
  92. (*                                                                      *)
  93. (*     Calls:   Color_Screen_Active                                     *)
  94. (*              PTR                                                     *)
  95. (*              Get_Virtual_Screen_Address                              *)
  96. (*              TimeSharingActive                                       *)
  97. (*                                                                      *)
  98. (*----------------------------------------------------------------------*)
  99.  
  100. VAR
  101.    Regs: Registers;
  102.  
  103. BEGIN  (* Get_Screen_Address *)
  104.                                    (* Check if timesharing active.   *)
  105.    IF TimeSharingActive THEN
  106.       CASE MultiTasker OF
  107.          DoubleDos:  BEGIN
  108.                         Regs.Ax := $EC00;
  109.                         MsDos( Regs );
  110.                         Actual_Screen := PTR( Regs.Es, 0 );
  111.                      END;
  112.          TaskView,
  113.          TopView,
  114.          MSWindows,
  115.          DesqView:   CASE Current_Video_Mode OF
  116.                         HiRes_GraphMode : Actual_Screen := PTR( Color_Screen_Address , 0 );
  117.                         EGA_GraphMode   : Actual_Screen := PTR( EGA_Screen_Address , 0 );
  118.                         ELSE              Actual_Screen := Virtual_Screen;
  119.                      END (* CASE *);
  120.          ELSE;
  121.       END
  122.    ELSE
  123.       IF Color_Screen_Active THEN
  124.          Actual_Screen := PTR( Color_Screen_Address , 0 )
  125.       ELSE
  126.          Actual_Screen := PTR( Mono_Screen_Address , 0 );
  127.  
  128. END    (* Get_Screen_Address *);
  129.